home *** CD-ROM | disk | FTP | other *** search
/ PC World Interactive 7 / PC World Interactive 7.iso / program / pasprog.EXE / BFS.PAS < prev    next >
Pascal/Delphi Source File  |  1980-01-10  |  2KB  |  71 lines
  1. Uses Crt;
  2. Const
  3.    FExt='.Bin';
  4. Var
  5.    F:File;
  6.    R:Integer;
  7.    D:String;
  8.    AKey,FPos:Word;
  9. function Segment:word;
  10. begin
  11.    if (mem[0:$0410] and $30)=$30 then segment:=$b000
  12.                                  else segment:=$b800;
  13. end;
  14. Function Key:Word;
  15. Var
  16.    Ch:Char;
  17. Begin
  18.    Ch:=ReadKey;
  19.    If (Ch=#0) And KeyPressed Then
  20.    Begin
  21.       Ch:=ReadKey;
  22.       Key:=Ord(Ch) Shl 8;
  23.    End Else Key:=Ord(Ch);
  24. End;
  25. Begin
  26.    If ParamCount=0 Then
  27.    Begin
  28.       Write('Dosya Adì : ');
  29.       Readln(D);
  30.       If D='' Then
  31.       Begin
  32.          Writeln('Dosya ÿsmi Geçersiz.');
  33.          Halt;
  34.       End;
  35.    End Else D:=ParamStr(1);
  36.    If Pos('.',D)=0 Then D:=D+FExt;
  37.    Assign(F,D);
  38.    {$I-} Reset(F,4000); {$I+}
  39.    If IOResult<>0 then
  40.    Begin
  41.       Writeln(D,' ÿsimli Dosya Bulunamadì.');
  42.       Halt;
  43.    End;
  44.    While Not Eof(F) Do
  45.    Begin
  46.       BlockRead(F,Ptr(Segment,0)^,1,R);
  47.       If R<1 Then Break;
  48.       Repeat
  49.          AKey:=Key;
  50.          Case AKey Of
  51.               27   :Begin
  52.                        Close(F);
  53.                        ClrScr;
  54.                        Writeln('TurboSoft Binary File Show by Murat AKSARAY');
  55.                        Halt;
  56.                     End;
  57.               18432:If FilePos(F)>1 Then
  58.                     Begin
  59.                        FPos:=FilePos(F)-2;
  60.                        Seek(F,FPos);
  61.                        Break;
  62.                     End;
  63.               20480:Break;
  64.          End;
  65.       Until 1=2;
  66.    End;
  67.    Close(F);
  68.    ClrScr;
  69.    Writeln('TurboSoft Binary File Show 1995 by Murat AKSARAY');
  70. End.
  71.